home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / MISCEOUS / HOROSCOP.LZH / ASTROLPC.BAS < prev    next >
BASIC Source File  |  1986-02-04  |  36KB  |  706 lines
  1. 10 FOR I=1 TO 23:PRINT:NEXT I:' clear screen
  2. 20 PRINT" ==========================================================================="
  3. 30 PRINT
  4. 40 PRINT "   ASTROL7, The Public Domain Astrology Program"
  5. 50 PRINT
  6. 60 PRINT "   Now includes aspects -"
  7. 70 PRINT "   Natal aspects, transiting aspects and chart synastry for relationships."
  8. 80 PRINT
  9. 90 PRINT "   Created by John A. Halloran, 10/16/85"
  10. 100 PRINT"   Top-down structure by David C. Oshel, 12/27/85"
  11. 110 PRINT"   Revision 7 by John A. Halloran, 01/12/86"
  12. 120 PRINT
  13. 130 PRINT"   (C) Copyright 1986 John A. Halloran"
  14. 140 PRINT"   May not be used for commercial purposes without written permission"
  15. 150 PRINT"   from the author."
  16. 160 PRINT
  17. 170 REM      CP/M Version for Microsoft BASIC-80 ver. 5.21 (MBASIC)
  18. 180 REM      PC Version for IBM BASIC
  19. 190 REM
  20. 200 PRINT" =========================================================================="
  21. 210 PRINT:PRINT:PRINT
  22. 220 REM
  23. 230 '-------------------------------------
  24. 240 '  Static block (DIM, DEF, etc.)
  25. 250 '-------------------------------------
  26. 260 DEFINT I
  27. 270 DIM H(12),H$(12),C$(12),F$(10),T(3),CH(12),CL(12),C(12),M(12),K(10),U(12),A$(9),ASPECT$(85),ASPDEG(85),ASPMIN(85),DDEG(85),DMIN(85),CHART1(12),XK(12),DIR$(85)
  28. 280 DEF FNR(X!) = PI# / 180 * X!: '  CONVERTS DEGREES TO RADIANS
  29. 290 DEF FND(X!) = 180 / PI# * X!: '  CONVERTS RADIANS TO DEGREES
  30. 300 DEF FNQ(X!) = SGN (X!) * (  INT (  ABS (X!)) + ( ABS (X!) - INT ( ABS (X!))) * 100 / 60): '  CONVERTS DEGREES/MINUTES TO DEGREES DECIMAL
  31. 310 DEF FNU(X!) = X! - ( INT (X! / MO) * MO):MO = 360: '  MODULUS FUNCTION, RETURNS RESULT WITHIN CIRCLE
  32. 320 DEF FNW(X!) = (CINT (X! * 100)) / 100: '  ROUNDS OFF TO TWO DECIMAL PLACES
  33. 330 DEF FNX(X!) = ATN (X! /  SQR (1 - X! * X!)): '  ARCSINE FUNCTION
  34. 340 DEF FNY(X!) = ATN ( SQR (1 - X! * X!) / X!): '  ARCCOSINE FUNCTION
  35. 350 DEF FNS(X!) = SIN (PI# / 180 * X!): '  SINE FUNCTION WHEN WORKING WITH DEGREES
  36. 360 DEF FNC(X!) = COS (PI# / 180 * X!): '  COSINE FUNCTION WHEN WORKING WITH DEGREES
  37. 370 DEF FNT(X!) =  TAN (PI# / 180 * X!): '  TANGENT FUNCTION WHEN WORKING WITH DEGREES
  38. 380 DEF FNP(X!)=SGN (X!)*((ABS(X!)/M!)/360-INT((ABS(X!)/M!)/360))*360
  39. 390 PI# = 3.14159265#: '  DEFINE "PI"
  40. 400 ZA$ = "AriTauGemCanLeoVirLibScoSagCapAquPis": ' Aries, Taurus, Gemini, etc.
  41. 410 '-------------------------------------
  42. 420 '   Main Program Control Loop
  43. 430 '-------------------------------------
  44. 440 'FOR I=1 TO 23:PRINT:NEXT I 'clear screen
  45. 450 LOOPCOUNT%=0:LOOPING% = 1
  46. 460 WHILE LOOPING% = 1
  47. 470   RESTORE    'rewind data statement pointer
  48. 480   GOSUB 610  'print title
  49. 490   GOSUB 670  'assistance?
  50. 500   GOSUB 920  'get inputs
  51. 510   GOSUB 1200 'crunch numbers
  52. 520   GOSUB 4600 'display results
  53. 530   GOSUB 3180 'aspects
  54. 540   GOSUB 3530 'transits/synastry
  55. 550   GOSUB 740: LOOPING% = YES%  'shall we continue?
  56. 560 WEND
  57. 570 END ' the only program exit
  58. 580 '-------------------------------------
  59. 590 '   Title
  60. 600 '-------------------------------------
  61. 610 IF LOOPCOUNT%=0 THEN 630 ELSE 620
  62. 620 PRINT:PRINT:PRINT:PRINT "ASTROL7, The Public Domain Astrology Program"
  63. 630 RETURN
  64. 640 '--------------------------------
  65. 650 '   Assistance?
  66. 660 '--------------------------------
  67. 670 PRINT:PRINT "Do you want assistance?  Y/N  ";: GOSUB 860
  68. 680 IF YES%=1 THEN PRINT:GOSUB 4960
  69. 690 PRINT:PRINT
  70. 700 RETURN
  71. 710 '--------------------------------
  72. 720 '  Do another?
  73. 730 '--------------------------------
  74. 740 PRINT:PRINT "Calculate another birthdate?  Y/N  ";
  75. 750 GOSUB 860
  76. 760 RETURN
  77. 770 '------------------------------
  78. 780 '   Get a key (uppercase)
  79. 790 '------------------------------
  80. 800 A$=INKEY$:IF LEN(A$)=0 THEN 800
  81. 810 IF A$ >= "a" AND A$ <= "z" THEN A$ = CHR$(ASC(A$)-32): ' Uppercase
  82. 820 RETURN
  83. 830 '------------------------------
  84. 840 '   Get YES/NO answer
  85. 850 '------------------------------
  86. 860 GOSUB 800: PRINT A$
  87. 870 IF A$="Y" THEN YES%=1 ELSE YES%=0
  88. 880 RETURN
  89. 890 '------------------------------
  90. 900 '   Get inputs
  91. 910 '------------------------------
  92. 920 OK% = 0
  93. 930 WHILE OK% = 0
  94. 940   INPUT"DATE: MM.DDYYYY ";DA$
  95. 950   A$=DA$
  96. 960   M= VAL(MID$(A$,1,2))
  97. 970   D= VAL(MID$(A$,4,2))
  98. 980   Y= VAL(MID$(A$,6,5))
  99. 990   INPUT"AM*PM ";TI$
  100. 1000   FOR I=1 TO LEN(TI$) 'ensure AM/PM string is uppercase
  101. 1010     F$=MID$(TI$,I,1):IF F$ >= "a" AND F$ <= "z" THEN F$=CHR$(ASC(F$)-32)
  102. 1020     MID$(TI$,I,1) = F$
  103. 1030     NEXT I
  104. 1040   F$=TI$
  105. 1050   INPUT"TIME: HH.MM ";TI
  106. 1060   F!=TI
  107. 1070   INPUT"TIME ZONE IN HOURS:  HH.MM "; X!
  108. 1080   INPUT"LONGITUDE: DDD.MM ";LN!
  109. 1090   L5!=LN!:L5!=FNQ(L5!)
  110. 1100   F!=FNQ(F!)+FNQ(X!)
  111. 1110   INPUT"LATITUDE:   DD.MM ";LT#
  112. 1120   LA!=LT#:LA!=FNR(FNQ(LA!))
  113. 1130   PRINT:PRINT"All OK?  Y/N  ";:GOSUB 860: OK% = YES%
  114. 1140  IF YES%=0 THEN PRINT
  115. 1150 WEND
  116. 1160 RETURN
  117. 1170 '--------------------------------
  118. 1180 '   Crunch numbers
  119. 1190 '--------------------------------
  120. 1200 PRINT:PRINT "Calculating..."
  121. 1210 FOR I = 1 TO 12: READ C$(I): NEXT I: '<---  FILL PLANET NAME ARRAY
  122. 1220 FOR I=1 TO 9:READ A$(I):NEXT I: '<---  FILL ASPECT NAME ARRAY
  123. 1230 IF F$="PM" THEN F!=F!+12
  124. 1240 '-------------------------------------------------------------
  125. 1250 '  Julian Day Number; Y,M,D in/out, JD# out
  126. 1260 '-------------------------------------------------------------
  127. 1270 Y1#=Y:M1#=M:D1#=D:IF M1#=1 OR M1#=2 THEN Y1#=Y1#-1:M1#=M1#+12
  128. 1280 IF Y1#<1582 THEN B1#=0 ELSE IF Y1#=1582 AND M1#<10 THEN B1#=0 ELSE IF Y1#=1582 AND M1#=10 AND D1#<15 THEN B1#=0 ELSE A1#=INT(Y1#/100):B1#=2-A1#+INT(A1#/4)
  129. 1290 C1#=INT(365.25*Y1#):D2#=INT(30.6001#*(M1#+1)):JD#=B1#+C1#+D2#+D1#+1720994.5#
  130. 1300 T#=((JD#-2415020!)+ F!/24)/36525!
  131. 1310 OB!= FNR(23.4523- .0130125*T#):GOTO 1330
  132. 1330 RA!=FNR(FNU((6.64607+2400.05*T#+.0000258*T#*T#+F!)*15-L5!)):'<--- RAMC IN RADIANS
  133. 1340 '<------------------
  134. 1350 FOR I=1 TO 10:'<--- LOOP FOR PLANETS
  135. 1360 IF I=2 THEN 1370 ELSE 1390
  136. 1370 GOSUB 2440:'<---  calculate moon
  137. 1380 GOTO 1750
  138. 1390   MO=2*PI#:'<--- MOD FUNCTION IN RADIANS
  139. 1400   GOSUB 1900:M!=FNU(S!):'<--- CALCULATE MEAN ANOMALY
  140. 1410   GOSUB 1900:E!=FND(S!):'<--- CALCULATE ECCENTRICITY
  141. 1420   EA!=M!:FOR A=1 TO 5:EA!=M!+E!*SIN(EA!):NEXT A:'<--- SOLVE KEPLER'S EQUATION
  142. 1430   READ AU!:'<--- SEMI-MAJOR AXIS
  143. 1440   E1!=.0172021/(AU!^1.5*(1-E!*COS(EA!))):'<--- BEGIN VELOCITY COORDINATES
  144. 1450   XW!=-(AU!*E1!)*SIN(EA!):YW!=(AU!*E1!)*(1-E!*E!)^.5*COS(EA!):'<--- PERIFOCAL COORD'S
  145. 1460 '<---- CALCULATE ARGUMENT OF PERIHELION AND ASCENDING NODE
  146. 1470   GOSUB 1900:AP!=S!:GOSUB 1900:AN!=S!
  147. 1480   GOSUB 1900:IN!=S!:'<--- CALCULATE INCLINATION
  148. 1490   X!=XW!:Y!=YW!:GOSUB 2220:'<--- ROTATE VELOCITY COORDINATES
  149. 1500   XH!=X!:YH!=Y!:ZH!=G!:'<--- HELIO ECLIPTIC RECTANGULAR VELOCITY COORDINATES
  150. 1510 '<---- STORE SUN VELOCITY COORDINATES
  151. 1520   MO=360:IF I=1 THEN XA!=-XH!:YA!=-YH!:ZA!=-ZH!:AB=0:GOTO 1560
  152. 1530 '<---- GEO COMPONENTS OF SOLAR VELOCITY
  153. 1540   XW!=XH!+XA!:YW!=YH!+YA!:ZW!=ZH!+ZA!
  154. 1550 '<---- PERIFOCAL COORDINATES FOR RECTANGULAR POSITION COORDINATES
  155. 1560   X!=AU!*(COS(EA!)-E!):Y!=AU!*SIN(EA!)*(1-E!*E!)^.5
  156. 1570   GOSUB 2220:XX!=X!:YY!=Y!:ZZ!=G!:'<--- ROTATE FOR RECTANGULAR POSITION COORD'S
  157. 1580 '<---- HARMONIC TERMS FOR OUTER PLANETS
  158. 1590 '<---- CORRECT RECTANGULAR COORDINATES
  159. 1600   IF I>5 THEN GOSUB 2060:XX!=XX!+T(2):YY!=YY!+T(1):ZZ!=ZZ!+T(3)
  160. 1610   XK!=(XX!*YH!-YY!*XH!)/(XX!*XX!+YY!*YY!):XK(I)=XK!:'<--- COMPUTE HELIO DAILY MOTION
  161. 1620   HDM!=FND(XK!):'<--- HELIO DAILY MOTION
  162. 1630   R$="  ":'<--- SET RETROGRADE STRING TO BLANK
  163. 1640 '<---- CONVERT HELIO RECTANGULAR TO SPHERICAL COORDINATES
  164. 1650   AB=0:BR!=0:GOSUB 1820:AB=1
  165. 1660   CH(I)=SS!:CL(I)=C!:'<--- STORE HELIO LONGITUDE & LATITUDE
  166. 1670 '<---- STORE EARTH/SUN COORDINATES
  167. 1680   IF I=1 THEN C$(1)="SUN":X1!=XX!:Y1!=YY!:Z1!=ZZ!:GOTO 1710
  168. 1690   XX!=XX!-X1!:YY!=YY!-Y1!:ZZ!=ZZ!-Z1!:'<--- HELIO TO GEO RECTANGULAR
  169. 1700   XK!=(XX!*YW!-YY!*XW!)/(XX!*XX!+YY!*YY!):XK(I)=XK!:'<--- GEO DAILY MOTION
  170. 1710   BR!=5.768300000000005D-03*SQR(XX!*XX!+YY!*YY!+ZZ!*ZZ!)*FND(XK!):'<--- ABERRATION
  171. 1720   IF XK!<0 THEN R$=" R":'<--- RETROGRADE CHECK
  172. 1730 '<---- CONVERT RECTANGULAR TO SPHERICAL
  173. 1740   GOSUB 1820:C(I)=SS!:M(I)=P!:IF XK!<0 THEN C(I)=-SS!
  174. 1750 NEXT I
  175. 1760 GOSUB 2860 ' calculate cusps
  176. 1770 RETURN
  177. 1780 '--------------------------------------
  178. 1790 '   Various important subroutines
  179. 1800 '--------------------------------------
  180. 1810 '<--- RECTANGULAR TO SPHERICAL COORDINATES
  181. 1820 X!=XX!:Y!=YY!:GOSUB 1990:K!=A!:C!=FND(A!)+NU!+BR!:IF I=1 AND AB=1 THEN C!=FNU(C!+180)
  182. 1830 C!=FNU(C!+SD!):SS!=C!:Y!=ZZ!:X!=R!:GOSUB 1990:IF A!>.35 THEN A!=A!-2*PI#
  183. 1840 P!=FND(A!)
  184. 1850 ELC%=0: '<--- COUNTER TO RESTRICT U(1-10) TO PLANETARY LONGITUDE
  185. 1860 GOSUB 2270:P$=Z$+R$:C!=P!:GOSUB 2270:IF AB=1 THEN F$(I)=P$ ELSE 1870
  186. 1870 RETURN
  187. 1880 '<---------------
  188. 1890 '<--- ASSEMBLE ORBITAL ELEMENTS
  189. 1900 READ S!,S1#,S2!:S!=S!+S1#*T#+S2!*T#^2:S!=FNR(S!)
  190. 1910 RETURN
  191. 1920 '<------------------------------------------------------
  192. 1930 '<--- POLAR TO RECTANGULAR COORDINATES
  193. 1940 IF A!=0 THEN A!=1.7E-09
  194. 1950 X!=R!*COS(A!):Y!=R!*SIN(A!)
  195. 1960 RETURN
  196. 1970 '<---------------------------------
  197. 1980 '<--- RECTANGULAR TO POLAR COORDINATES
  198. 1990 IF Y!=0 THEN Y!=1.7E-09
  199. 2000 R!=(X!*X!+Y!*Y!)^.5
  200. 2010 A!=ATN(Y!/X!):IF A!<0 THEN A!=A!+PI#
  201. 2020 IF Y!<0 THEN A!=A!+PI#
  202. 2030 RETURN
  203. 2040 '<-----------------
  204. 2050 '<--- CALCULATE HARMONIC TERMS FOR OUTER PLANETS
  205. 2060 K(6)=11:K(7)=5:K(8)=4:K(10)=4:K(9)=4:'<--- NUMBER OF HARMONIC TERMS FOR PLANET
  206. 2070 FOR IK=1 TO 3
  207. 2080   IF I=6 AND IK=3 THEN T(3)=0:GOTO 2190 'Return
  208. 2090   '.............................................
  209. 2100   IF IK=3 THEN K(I)=K(I)-1
  210. 2110   '<--- ASSEMBLE TERMS
  211. 2120   GOSUB 1900: A!=0
  212. 2130   FOR IJ=1 TO K(I)
  213. 2140     READ U!,V!,W!
  214. 2150     A!=A!+FNR(U!)*COS((V!*T#+W!)*PI#/180)
  215. 2160     NEXT IJ
  216. 2170   T(IK)=FND(S!+A!)
  217. 2180   NEXT IK
  218. 2190 RETURN
  219. 2200 '<----------------------------------------------------------------
  220. 2210 '<--- ROTATE ROUTINE USED FOR POSITION AND VELOCITY COORDINATES
  221. 2220 GOSUB 1990:A!=A!+AP!:GOSUB 1940:D!=X!:X!=Y!:Y!=0:GOSUB 1990:A!=A!+IN!:GOSUB 1940:G!=Y!:Y!=X!:X!=D!
  222. 2230 GOSUB 1990:A!=A!+AN!:IF A!<O THEN A!=A!+2*PI#
  223. 2240 GOSUB 1940
  224. 2250 RETURN
  225. 2260 '<----------------
  226. 2270 U! =  ABS (C!): '<---  REMOVE NEGATION IF PRESENT
  227. 2280 IF ELC% <1 THEN U(I)=U!:'<---  STORE ECLIPTIC LONGITUDE FOR ASPECT CALCULATION
  228. 2290 IF LOOPCOUNT%<1 AND ELC%<1 THEN CHART1(I)=U!:'<---  STORE LONGITUDE FOR TRANSIT/SYNASTRY CALCULATION
  229. 2300 ELC%=ELC%+1
  230. 2310 Z3 =  INT (U!):Q =  INT (Z3 / 30) + 1: '<---  'Q' IS ZODIAC SIGN NUMBER
  231. 2320 Z7 =  INT ( FNW((Z3 / 30 -  INT ( Z3 / 30 )) * 30)): '<---  NUMBER OF DEGREES
  232. 2330 X$ =  RIGHT$ ( STR$ (Z7),2): IF Z7 < 10 THEN X$ = "0" +  RIGHT$ (X$,1)
  233. 2340 ZZ$ =  STR$ ( INT (((U! - Z3) * 60 + .5))): IF  VAL (ZZ$) < 10 THEN ZZ$ = "0" +  RIGHT$ (ZZ$,1):'<---  STRING FOR MINUTES
  234. 2350 IF VAL(ZZ$)=60 THEN ZZ$="59"
  235. 2360 B$ =  MID$ (ZA$,Q * 3 - 2,3): '<---  SELECTS ZODIAC STRING FROM ZA$
  236. 2370 A$ = "+": IF C! < 0 THEN A$ = "-": '<---  SETS SIGN STRING FOR LATITUDE/DECLINATION
  237. 2380 D$ = A$ + X$ + " " +  RIGHT$ (ZZ$,2): '<---  LATITUDE/DECLINATION STRING
  238. 2390  IF EQ = 1 THEN B$ = " ":X$ =  RIGHT$ (" " + STR$ (Z3),3): '<---  FLAG FOR 360-DEGREE NOTATION
  239. 2400 Z$ =  LEFT$ (C$(I),2) + " " + X$ + B$ +  RIGHT$ (ZZ$,2): '<---  PLANET AND POSITION STRING
  240. 2410 A$ =  RIGHT$ (Z$,7): '<---  ZODIAC NOTATION STRING
  241. 2420 RETURN
  242. 2430 '<----------------------
  243. 2440 '<--- MOON & MOON'S NODE ROUTINE
  244. 2450 '<--- COMPUTE MEAN LUNAR LONGITUDE
  245. 2460 LL#=973563!+1732564379#*T#-4*T#*T#
  246. 2470 '<--- COMPUTE SUN'S MEAN LONGITUDE OF PERIGEE
  247. 2480 G#=1012400!+6189*T#
  248. 2490 '<--- COMPUTE MEAN LUNAR NODE
  249. 2500 N#=933060!-6962910!*T#+7.5*T#*T#
  250. 2510 MLN#= FNP(N#):'<--- MEAN LUNAR NODE
  251. 2520 '<--- COMPUTE MEAN LONGITUDE OF LUNAR PERIGEE
  252. 2530 G1#=1203590!+14648523#*T#-37*T#*T#
  253. 2540 '<--- COMPUTE MEAN ELONGATION OF MOON FROM SUN
  254. 2550 D#=1262660!+1602961611#*T#-5*T#*T#:M#=3600
  255. 2560 '<--- COMPUTE AUXILIARY ANGLES
  256. 2570 L#=(LL#-G1#)/M#:L1#=((LL#-D#)-G#)/M#:F#=(LL#-N#)/M#:D#=D#/M#:Y#=2*D#
  257. 2580 '<--- COMPUTE MOON'S PERTURBATIONS
  258. 2590 ML#=22639.6*FNS(L#)-4586.4*FNS(L#-Y#)
  259. 2600 ML#=ML#+2369.9*FNS(Y#)+769*FNS(2*L#)-669*FNS(L1#)
  260. 2610 ML#=ML#-411.6*FNS(2*F#)-212*FNS(2*L#-Y#)
  261. 2620 ML#=ML#-206*FNS(L#+L1#-Y#)+192*FNS(L#+Y#)
  262. 2630 ML#=ML#-165*FNS(L1#-Y#)+148*FNS(L#-L1#)-125*FNS(D#)
  263. 2640 ML#=ML#-110*FNS(L#+L1#)-55*FNS(2*F#-Y#)
  264. 2650 ML#=ML#-45*FNS(L#+2*F#)+40*FNS(L#-2*F#)
  265. 2660 G#=FNU((LL#+ML#)/M#):XK(I)=13*XK!:'<--- LUNAR LONGITUDE
  266. 2670 ELC%=0: '<--- COUNTER TO CAUSE U(2) TO BE STORED
  267. 2680 C!=G#:GOSUB 2270
  268. 2690 F$(I)=Z$
  269. 2700 '<--- COMPUTE LUNAR LATITUDE
  270. 2710 MB!=18461.5*FNS(F!)+1010*FNS(L!+F!)-999*FNS(F!-L!)
  271. 2720 MB!=MB!-624*FNS(F!-Y!)+199*FNS(F!+Y!-L!)
  272. 2730 MB!=MB!-167*FNS(L!+F!-Y!)+117*FNS(F!+Y!)
  273. 2740 MB!=MB!+62*FNS(2*L!+F!)-33*FNS(F!-Y!-L!)
  274. 2750 MB!=MB!-32*FNS(F!-2*L!)-30*FNS(L1!+F!-Y!)
  275. 2760 MB!=FNP(MB!):'<--- LUNAR LATITUDE
  276. 2770 '<--- COMPUTE TRUE LUNAR NODE
  277. 2780 TN!=N!+5392*FNS(2*F!-Y!)-541*FNS(L1!)-442*FNS(Y!)
  278. 2790 TN!=TN!+423*FNS(2*F!)-291*FNS(2*L!-2*F!)
  279. 2800 TN!=FNU(TN!/M!):'<--- TRUE LUNAR NODE
  280. 2810 RETURN
  281. 2820 '---------------------------------
  282. 2830 '   Compute Placidus Cusps
  283. 2840 '---------------------------------
  284. 2850 '<--- MIDHEAVEN
  285. 2860 X!=ATN(TAN(RA!)/COS(OB!)):IF X!<0 THEN X!=X!+PI#
  286. 2870 IF RA!>PI# THEN X!=X!+PI#
  287. 2880 MC!=FNU(FND(X!)+SD!)
  288. 2890 U(12)=MC!:XK(12)=360*XK(1)
  289. 2900 IF LOOPCOUNT%=0 THEN CHART1(12)=MC!
  290. 2910 '<--- ASCENDANT
  291. 2920 A1!=ATN(COS(RA!)/(-SIN(RA!)*COS(OB!)-TAN(LA!)*SIN(OB!))):IF A1!<0 THEN A1!=A1!+PI#
  292. 2930 IF COS(RA!)<0 THEN A1!=A1!+PI#
  293. 2940 A1!=FNU(FND(A1!)+SD!)
  294. 2950 U(11)=A1!:XK(11)=360*XK(1)
  295. 2960 IF LOOPCOUNT%=0 THEN CHART1(11)=A1!
  296. 2970 '<--- PLACIDUS HOUSES
  297. 2980 Y!=0:MO=360:H(4)=FNU(MC!+180-SD!):H(1)=FNU(A1!-SD!)
  298. 2990 R1!=RA!+FNR(30):FF!=3:GOSUB 3090:H(5)=FNU(LO!+180)
  299. 3000 R1!=RA!+FNR(60):FF!=1.5:GOSUB 3090:H(6)=FNU(LO!+180):R1!=RA!+FNR(120):Y!=1
  300. 3010 GOSUB 3090:H(2)=LO!:R1!=RA!+FNR(150):FF!=3:GOSUB 3090:H(3)=LO!
  301. 3020 ELC%=ELC%+1: '<--- COUNTER TO RESTRICT U(1-10) TO PLANETARY LONGITUDES
  302. 3030 FOR I=1 TO 12:H(I)=FNU(H(I)+SD!):IF I>6 THEN H(I)=FNU(H(I-6)+180)
  303. 3040 C!=H(I):GOSUB 2270:H$(I)=A$:NEXT I
  304. 3050 RETURN
  305. 3060 '----------------------------------
  306. 3070 '   A Placidus subroutine
  307. 3080 '----------------------------------
  308. 3090   X!=-1:IF Y!=1 THEN X!=1
  309. 3100   FOR I=1 TO 10:XX!=FNY(X!*SIN(R1!)*TAN(OB!)*TAN(LA!)):IF XX!<0 THEN XX!=XX!+PI#
  310. 3110   R2!=RA!+(XX!/FF!):IF Y!=1 THEN R2!=RA!+PI#-(XX!/FF!)
  311. 3120   R1!=R2!:NEXT I:LO!=ATN(TAN(R1!)/COS(OB!)):IF LO!<0 THEN LO!=LO!+PI#
  312. 3130   IF SIN(R1!)<0 THEN LO!=LO!+PI#
  313. 3140   LO!=FND(LO!)
  314. 3150   RETURN
  315. 3160 '----------------------------------
  316. 3170 '   Compute aspects
  317. 3180 '----------------------------------
  318. 3190 PRINT:PRINT "Display aspects?  Y/N  ";:GOSUB 860:PRINT
  319. 3200 IF YES%=0 THEN 3490
  320. 3210 CLS:LNE=0:BRK=18
  321. 3220 PRINT:PRINT "   ASPECTS       ANGLES     ORBS"
  322. 3230 PRINT "-------------   --------   ------"
  323. 3235 COMM2=0
  324. 3240 FOR I=1 TO 12:'<--- ASPECT LOOP
  325. 3250 FOR J=1 TO 12:'<--- PLANET LOOP #2
  326. 3260 IF J<=I THEN 3360
  327. 3270 ASP=ABS(U(I)-U(J)):IF ASP>180 THEN ASP=360-ASP
  328. 3280 ASP$=STR$(CINT(ASP*100)):ASPDEG$=LEFT$(ASP$,LEN(ASP$)-2):ASPDEG=VAL(ASPDEG$):ASPMIN=CINT(60*(ASP-ASPDEG)):IF ASPMIN=60 THEN 3290 ELSE 3300
  329. 3290 ASPDEG=ASPDEG+1:ASPMIN=0
  330. 3300 FOR K=1 TO 9:D=ABS(ASP-VAL(RIGHT$(A$(K),3))):'<---  CHECK ANGLE AGAINST ASPECTS
  331. 3310 D$=STR$(CINT(D*100)):DDEG$=LEFT$(D$,LEN(D$)-2):DDEG=VAL(DDEG$):DMIN=CINT(60*(D-DDEG)):IF DMIN=60 THEN 3320 ELSE 3330
  332. 3320 DDEG=DDEG+1:DMIN=0
  333. 3330 '<---  IF WITHIN ORB, PRINT ASPECT
  334. 3340 IF D<VAL(MID$(A$(K),4,1)) THEN PRINT C$(I)"  "LEFT$(A$(K),3)"  "C$(J)"   ";:PRINT USING "###";ASPDEG;:PRINT "d ";:PRINT USING "##";ASPMIN;:PRINT "m   ";:PRINT USING "#";DDEG;:PRINT "d ";:PRINT USING "##";DMIN;:PRINT "m":LNE=LNE+1:GOSUB 3380
  335. 3350 NEXT K
  336. 3360 NEXT J:NEXT I
  337. 3365 JCI$="Internal Communication Index:  ":PRINT:PRINT JCI$;CINT(COMM2)
  338. 3370 GOTO 3430
  339. 3380 ASPECT$(LNE)=C$(I)+"  "+LEFT$(A$(K),3)+"  "+C$(J)+"   ":'<--- STORE ASPECT  FOR LINE PRINTER
  340. 3390 ASPDEG(LNE)=ASPDEG:ASPMIN(LNE)=ASPMIN:DDEG(LNE)=DDEG:DMIN(LNE)=DMIN
  341. 3395 STEP2=(VAL(MID$(A$(K),4,1))-D):COMM2=COMM2+STEP2:K=9
  342. 3400 IF INT(LNE/BRK)=1 THEN 3410 ELSE 3420
  343. 3410 BRK=BRK+18:PRINT TAB(43) "For more, press Return...":GOSUB 800
  344. 3420 RETURN
  345. 3430 PRINT:PRINT "Print hardcopy?  Y/N  ";:GOSUB 860:PRINT
  346. 3440 IF YES% = 0 THEN 3490:' No print request, so exit from subroutine
  347. 3450 GOSUB 4880
  348. 3460 LPRINT "   ASPECTS       ANGLES     ORBS"
  349. 3470 LPRINT "-------------   --------   ------"
  350. 3480 FOR I=1 TO LNE:LPRINT ASPECT$(I);:LPRINT USING "###";ASPDEG(I);:LPRINT "d ";:LPRINT USING "##";ASPMIN(I);:LPRINT "m   ";:LPRINT USING "#";DDEG(I);:LPRINT "d ";:LPRINT USING "##";DMIN(I);:LPRINT "m":NEXT I
  351. 3485 LPRINT:LPRINT JCI$;CINT(COMM2)
  352. 3490 RETURN
  353. 3500 '------------------------------
  354. 3510 '  Compute transits/synastry
  355. 3520 '------------------------------
  356. 3530 IF LOOPCOUNT%=0 THEN 4560
  357. 3540 PRINT:PRINT "Display aspects between the first chart and this chart?  Y/N  ";:GOSUB 860:PRINT
  358. 3550 IF YES%=0 THEN 4560
  359. 3560 DIREC$="":DIRECT$="":DIR$=""
  360. 3570 TCS$="":TCS=0:INPUT "For which:  Transits (T) or Chart Synastry (C) ";TCS$
  361. 3580 IF TCS$="C" OR TCS$="c" THEN TCS=2:GOTO 3610
  362. 3590 IF TCS$="T" OR TCS$="t" THEN TCS=1
  363. 3600 DIREC$="    DIRECTION":DIRECT$="   ---------"
  364. 3610 CLS:LNE=0:BRK=18:CI=0:NCI=0
  365. 3620 PRINT:PRINT USING "_##_ ";LOOPCOUNT%+1;:PRINT "ASPECTS #1    ANGLES     ORBS";DIREC$
  366. 3630 PRINT "-------------   --------   ------";DIRECT$
  367. 3640 FOR I=1 TO 12:'<--- ASPECT LOOP
  368. 3650 FOR J=1 TO 12:'<--- PLANET LOOP #2
  369. 3652 IF TI$="PM" AND TI=0 AND I>10 THEN 3970
  370. 3660 ASP=ABS(U(I)-CHART1(J)):IF ASP>180 THEN ASP=360-ASP:'<--- CHECK NEW PLANETARY LONGITUDES AGAINST VALUES STORED FOR 1ST CHART
  371. 3670 ASP$=STR$(CINT(ASP*100)):ASPDEG$=LEFT$(ASP$,LEN(ASP$)-2):ASPDEG=VAL(ASPDEG$):ASPMIN=CINT(60*(ASP-ASPDEG)):IF ASPMIN=60 THEN 3680 ELSE 3690
  372. 3680 ASPDEG=ASPDEG+1:ASPMIN=0
  373. 3690 FOR K=1 TO 9:ANG=VAL(RIGHT$(A$(K),3)):D=ABS(ASP-ANG):'<---  CHECK ANGLE AGAINST ASPECTS
  374. 3700 '<---  IF WITHIN ORB, PRINT ASPECT
  375. 3710 ORB=VAL(MID$(A$(K),4,1)):IF D>ORB THEN 3960
  376. 3720 D$=STR$(CINT(D*100)):DDEG$=LEFT$(D$,LEN(D$)-2):DDEG=VAL(DDEG$):DMIN=CINT(60*(D-DDEG)):IF DMIN=60 THEN 3730 ELSE 3740
  377. 3730 DDEG=DDEG+1:DMIN=0
  378. 3740 IF TCS=1 THEN 3750 ELSE 3950
  379. 3750 U=U(I):CH=CHART1(J):'<--- ROUTINE TO TEST WHETHER TRANSIT IS APPLYING OR SEPARATING
  380. 3760 IF ANG<=90 THEN 3770 ELSE 3800
  381. 3770 IF U<90 AND CH>270 THEN U=U+360:GOTO 3860
  382. 3780 IF CH<90 AND U>270 THEN CH=CH+360:GOTO 3860
  383. 3790 GOTO 3860
  384. 3800 IF ANG>90 AND ANG<180 THEN 3810 ELSE 3840
  385. 3810 IF U>180 AND U-CH>180 THEN CH=CH+360:GOTO 3860
  386. 3820 IF CH>180 AND CH-U>180 THEN U=U+360:GOTO 3860
  387. 3830 GOTO 3860
  388. 3840 IF ANG=180 AND CH-U>180 THEN U=U+360:GOTO 3860
  389. 3850 IF ANG=180 AND U-CH>180 THEN CH=CH+360
  390. 3860 IF U<CH AND ASP>ANG AND XK(I)>0 THEN DIR$="   Applying":GOTO 3940
  391. 3870 IF U<CH AND ASP<ANG AND XK(I)>0 THEN DIR$="   Separating":GOTO 3940
  392. 3880 IF U<CH AND ASP>ANG AND XK(I)<0 THEN DIR$="   Separating":GOTO 3940
  393. 3890 IF U<CH AND ASP<ANG AND XK(I)<0 THEN DIR$="   Applying":GOTO 3940
  394. 3900 IF U>CH AND ASP>ANG AND XK(I)>0 THEN DIR$="   Separating":GOTO 3940
  395. 3910 IF U>CH AND ASP<ANG AND XK(I)>0 THEN DIR$="   Applying":GOTO 3940
  396. 3920 IF U>CH AND ASP>ANG AND XK(I)<0 THEN DIR$="   Applying":GOTO 3940
  397. 3930 IF U>CH AND ASP<ANG AND XK(I)<0 THEN DIR$="   Separating"
  398. 3940 IF DDEG=0 AND DMIN=0 THEN DIR$="   Partile"
  399. 3950 PRINT C$(I)"  "LEFT$(A$(K),3)"  "C$(J)"   ";:PRINT USING "###";ASPDEG;:PRINT "d ";:PRINT USING "##";ASPMIN;:PRINT "m   ";:PRINT USING "#";DDEG;:PRINT "d ";:PRINT USING "##";DMIN;:PRINT "m";DIR$:LNE=LNE+1:GOSUB 4010
  400. 3960 NEXT K
  401. 3970 NEXT J:NEXT I
  402. 3980 IF TCS=1 THEN 4000
  403. 3990 PRINT:PRINT "Communication Index (Harmonious):   ",CINT(CI):PRINT "Communication Index (Inharmonious): ",CINT(ABS(NCI)):PRINT "Total Communication Index:   ",CINT(CI+ABS(NCI)):PRINT
  404. 4000 GOTO 4450
  405. 4010 IF TCS=1 THEN 4400
  406. 4020 CN=1:OP=1:IF I=J THEN OP=-1:'<--- ASSIGN COMMUNICATION INDEX FACTORS FOR ASPECTS AND PLANETS
  407. 4030 IF I=J THEN CN=.3
  408. 4040 IF I=3 OR I=7 OR I=8 OR J=3 OR J=7 OR J=8 THEN OP=-1:'<--- THE PLANETS AND ASPECTS REFERRED TO HERE CAN BE DETERMINED BY LOOKING AT THE FIRST TWO LINES OF  THE DATA BLOCK
  409. 4050 IF K=1 THEN FA1=((CN)*7):GOTO 4130
  410. 4060 IF K=2 THEN FA1=((OP)*6):GOTO 4130
  411. 4070 IF K=3 THEN FA1=3:GOTO 4130
  412. 4080 IF K=4 THEN FA1=-4:GOTO 4130
  413. 4090 IF K=5 THEN FA1=2:GOTO 4130
  414. 4100 IF K=6 OR K=7 THEN FA1=-1:GOTO 4130
  415. 4110 IF K=8 THEN FA1=-.8:GOTO 4130
  416. 4120 IF K=9 THEN FA1=1
  417. 4130 IF I=1 THEN FA2=5:GOTO 4250
  418. 4140 IF I=2 THEN FA2=5:GOTO 4250
  419. 4150 IF I=3 THEN FA2=1:GOTO 4250
  420. 4160 IF I=4 THEN FA2=4:GOTO 4250
  421. 4170 IF I=5 THEN FA2=3:GOTO 4250
  422. 4180 IF I=6 THEN FA2=2:GOTO 4250
  423. 4190 IF I=7 THEN FA2=1.5:GOTO 4250
  424. 4200 IF I=8 THEN FA2=1:GOTO 4250
  425. 4210 IF I=9 THEN FA2=1.5:GOTO 4250
  426. 4220 IF I=10 THEN FA2=1:GOTO 4250
  427. 4230 IF I=11 THEN FA2=3:GOTO 4250
  428. 4240 IF I=12 THEN FA2=1
  429. 4250 IF J=1 THEN FA3=5:GOTO 4370
  430. 4260 IF J=2 THEN FA3=5:GOTO 4370
  431. 4270 IF J=3 THEN FA3=1:GOTO 4370
  432. 4280 IF J=4 THEN FA3=4:GOTO 4370
  433. 4290 IF J=5 THEN FA3=3:GOTO 4370
  434. 4300 IF J=6 THEN FA3=2:GOTO 4370
  435. 4310 IF J=7 THEN FA3=1.5:GOTO 4370
  436. 4320 IF J=8 THEN FA3=1:GOTO 4370
  437. 4330 IF J=9 THEN FA3=1.5:GOTO 4370
  438. 4340 IF J=10 THEN FA3=1:GOTO 4370
  439. 4350 IF J=11 THEN FA3=3:GOTO 4370
  440. 4360 IF J=12 THEN FA3=1
  441. 4370 STEP1=((((ORB-D)*FA1)*FA2)*FA3):IF STEP1=>0 THEN 4380 ELSE 4390:'<--- INHARMONIOUS ASPECTS HAVE NEGATIVE VALUES
  442. 4380 CI=CI+STEP1:GOTO 4400
  443. 4390 NCI=NCI+STEP1
  444. 4400 ASPECT$(LNE)=C$(I)+"  "+LEFT$(A$(K),3)+"  "+C$(J)+"   ":DIR$(LNE)=DIR$
  445. 4410 ASPDEG(LNE)=ASPDEG:ASPMIN(LNE)=ASPMIN:DDEG(LNE)=DDEG:DMIN(LNE)=DMIN:K=9
  446. 4420 IF INT(LNE/BRK)=1 THEN 4430 ELSE 4440
  447. 4430 BRK=BRK+18:PRINT TAB(43) "For more, press Return...":GOSUB 800
  448. 4440 RETURN
  449. 4450 PRINT:PRINT "Print hardcopy?  Y/N  ";:GOSUB 860:PRINT
  450. 4460 IF YES% = 0 THEN 4560:' no print request, so exit from subroutine
  451. 4470 GOSUB 4880
  452. 4480 LPRINT USING "_##_ ";LOOPCOUNT%+1;:LPRINT "ASPECTS #1    ANGLES     ORBS";DIREC$
  453. 4490 LPRINT "-------------   --------   ------";DIRECT$
  454. 4500 FOR I=1 TO LNE:LPRINT ASPECT$(I);:LPRINT USING "###";ASPDEG(I);:LPRINT "d ";:LPRINT USING "##";ASPMIN(I);:LPRINT "m   ";:LPRINT USING "#";DDEG(I);:LPRINT "d ";:LPRINT USING "##";DMIN(I);:LPRINT "m";DIR$(I)
  455. 4510 IF I=40 THEN 4520 ELSE 4530
  456. 4520 GOSUB 4870
  457. 4530 NEXT I
  458. 4540 IF TCS=1 THEN 4560
  459. 4550 LPRINT:LPRINT "Communication Index (Harmonious):   ",CINT(CI):LPRINT "Communication Index (Inharmonious): ",CINT(ABS(NCI)):LPRINT "Total Communication Index:   ",CINT(CI+ABS(NCI)):LPRINT
  460. 4560 LOOPCOUNT%=LOOPCOUNT%+1:RETURN
  461. 4570 '------------------------------
  462. 4580 '  Display results
  463. 4590 '------------------------------
  464. 4600 GOSUB 4760 ' print planets on console
  465. 4610 GOSUB 4820 ' print houses  on console
  466. 4620 PRINT:PRINT "Print hardcopy?  Y/N  ";:GOSUB 860:PRINT 
  467. 4630 IF YES% = 0 THEN 4720 'No print request, so exit from subroutine
  468. 4640 GOSUB 4880
  469. 4650 LPRINT "DATE: "DA$;"    ";"TIME: "TI;TI$;"   ";"LONGITUDE: "LN!;"   ";"LATITUDE: "LT#
  470. 4660 LPRINT
  471. 4670 LPRINT "POSITIONS OF SUN, MOON, AND PLANETS"
  472. 4680 LPRINT F$(1),F$(5),F$(8),CHR$(13);CHR$(10);F$(2),F$(6),F$(9),CHR$(13);CHR$(10);F$(3),F$(7),F$(10),CHR$(13);CHR$(10);F$(4)
  473. 4690 LPRINT:LPRINT "PLACIDUS HOUSE CUSPS"
  474. 4700 LPRINT "1  "+H$(1),"2  "+H$(2),"3  "+H$(3),CHR$(13);CHR$(10);"4  "+H$(4),"5  "+H$(5),"6  "+H$(6),CHR$(13);CHR$(10);"7  "+H$(7),"8  "+H$(8),"9  "+H$(9),CHR$(13);CHR$(10);"10 "+H$(10),"11 "+H$(11),"12 "+H$(12)
  475. 4710 LPRINT:LPRINT
  476. 4720 RETURN
  477. 4730 '--------------------------------
  478. 4740 '   Print planets subroutine
  479. 4750 '--------------------------------
  480. 4760 PRINT:PRINT "POSITIONS OF SUN, MOON, AND PLANETS"
  481. 4770 PRINT F$(1),F$(5),F$(8),CHR$(13);CHR$(10);F$(2),F$(6),F$(9),CHR$(13);CHR$(10);F$(3),F$(7),F$(10),CHR$(13);CHR$(10);F$(4)
  482. 4780 RETURN
  483. 4790 '--------------------------------
  484. 4800 '   Print houses subroutine
  485. 4810 '--------------------------------
  486. 4820 PRINT
  487. 4830 PRINT "PLACIDUS HOUSE CUSPS"
  488. 4840 PRINT "1  "+H$(1),"2  "+H$(2),"3  "+H$(3),CHR$(13);CHR$(10);"4  "+H$(4),"5  "+H$(5),"6  "+H$(6),CHR$(13);CHR$(10);"7  "+H$(7),"8  "+H$(8),"9  "+H$(9),CHR$(13);CHR$(10);"10 "+H$(10),"11 "+H$(11),"12 "+H$(12)
  489. 4850 RETURN
  490. 4860 '--------------------------------
  491. 4870 PRINT:PRINT "If you wish to change paper, do so when this batch (40 lines) finishes printing.":PRINT
  492. 4880 ' Print results to printer
  493. 4890 PRINT "IF PRINTER IS READY, PRESS THE SPACE BAR..."
  494. 4900 GOSUB 800: IF ASC(A$) <> 32 THEN 4900
  495. 4910 WIDTH LPRINT 75
  496. 4920 RETURN
  497. 4930 '--------------------------------
  498. 4940 '  Explanatory Text
  499. 4950 '--------------------------------
  500. 4960 PRINT "This  program  calculates the zodiac sign positions of  the   ten"
  501. 4970 PRINT "planets,  including the sun and moon, and the twelve house cusps."
  502. 4980 PRINT "These   are   the   essential  elements  needed  to  draw  up   a"
  503. 4990 PRINT "horoscope.   I  chose  the  Placidus house system  because  I  am"
  504. 5000 PRINT "familiar  with  it from Raphael's Table of Houses.  With Revision" 
  505. 5010 PRINT "7, the program can also calculate and display the aspects between" 
  506. 5020 PRINT "the  planets.    Following  this  routine  is  one  that  enables" 
  507. 5030 PRINT "comparison  between two charts for analysis of transits or  chart" 
  508. 5040 PRINT "synastry.   The accuracy of the planetary positions is  generally" 
  509. 5050 PRINT "exact, with deviations being no more than about 5 minutes of arc;"
  510. 5060 PRINT "deviations   are   likely  to  be  due  more  to  inaccuracy   in"
  511. 5070 PRINT "entering the time of birth than to problems with the program."
  512. 5080 PRINT ""
  513. 5090 PRINT "Enter  the date of birth as the prompt (MM.DDYYYY)  shows,  e.g.," 
  514. 5100 PRINT "you  would enter October 16,  1985 as 10.161985.   Leading zeroes" 
  515. 5110 PRINT "are significant: you would enter June 9, 1961 as 06.091961."
  516. 5120 PRINT ""
  517. 5130 PRINT "Respond  to the AM*PM birth time prompt by typing in either AM or" 
  518. 5140 PRINT "PM." 
  519. 5150 PRINT ""
  520. 5160 GOSUB 800
  521. 5170 PRINT "The  TIME  prompt  asks  for the time as recorded  on  the  birth" 
  522. 5180 PRINT "certificate,  which  should  be Standard Time.   Astrologers  who" 
  523. 5190 PRINT CHR$(34)+"know  too much"+CHR$(34)+" should not enter Mean Local Time as the  program"
  524. 5200 PRINT "automatically  makes  this  adjustment.    However,  if  Daylight" 
  525. 5210 PRINT "Savings  Time  was  in effect when the time was  recorded  it  is" 
  526. 5220 PRINT "important  that an hour be subtracted from the birth time  before" 
  527. 5230 PRINT "entering  the time.   Also,  if the birth occurred between either" 
  528. 5240 PRINT "midnight or noon and 1 o'clock,  do NOT enter the time as  12.xx," 
  529. 5250 PRINT "but as 00.xx, e.g., 12:42 at night would be AM and 00.42."
  530. 5260 PRINT ""
  531. 5270 PRINT "TIME  ZONE  IN  HOURS refers to the  distance  in  hours  between" 
  532. 5280 PRINT "Greenwich  Time  and  the time zone in which the birth  time  was" 
  533. 5290 PRINT "recorded.  Hours for the U.S. Standard Time zones are as follows:" 
  534. 5300 PRINT ""
  535. 5310 PRINT "Atlantic 4"
  536. 5320 PRINT "Eastern  5"
  537. 5330 PRINT "Central  6"
  538. 5340 PRINT "Mountain 7"
  539. 5350 PRINT "Pacific  8"
  540. 5360 PRINT "Yukon    9"
  541. 5370 PRINT "Alaska- Hawaii 10"
  542. 5380 PRINT "Bering   11"
  543. 5390 GOSUB 800
  544. 5400 PRINT ""
  545. 5410 PRINT "Although  zones sometimes have irregular boundaries,  the general" 
  546. 5420 PRINT "rule  is  that  time  changes  by 1  hour  every  15  degrees  of" 
  547. 5430 PRINT "geographical longitude.  Zones east of Greenwich Time are entered" 
  548. 5440 PRINT "as negative hours, e.g., the zone in Paris, France is -1."
  549. 5450 PRINT ""
  550. 5460 PRINT "Geographical LONGITUDE can be taken from any  atlas.   Longitudes" 
  551. 5470 PRINT "west of Greenwich are positive.  Longitudes east of Greenwich are" 
  552. 5480 PRINT "negative.   The longitude of Los Angeles, which is 118 degrees 15" 
  553. 5490 PRINT "minutes  West,  is entered as 118.15.   The longitude  of  Paris," 
  554. 5500 PRINT "France is -2.20"
  555. 5510 PRINT ""
  556. 5520 PRINT "Geographical LATITUDE is positive north of the equator,  negative" 
  557. 5530 PRINT "south of the equator.  The latitude of Los Angeles is 34.03.  The" 
  558. 5540 PRINT "latitude of Rio de Janeiro, Brazil is -23.00."
  559. 5550 PRINT ""
  560. 5560 GOSUB 800
  561. 5570 PRINT "That's  it.   Be  patient while it says ";CHR$(34);"Calculating...";CHR$(34);"  On a  4"
  562. 5580 PRINT "MHz,  64K  RAM  machine  the CP/M version takes about 1 minute to"
  563. 5590 PRINT "calculate and print both the planetary positions and house  cusps"
  564. 5600 PRINT "to  the  screen.   On a 640K RAM XT the compiled  IBM  compatible"
  565. 5610 PRINT "version  takes less than 10 seconds.   If you want to save a hard"
  566. 5620 PRINT "copy of your results,  the program provides prompts for  printing"
  567. 5630 PRINT "to your printer."
  568. 5640 PRINT ""
  569. 5650 GOSUB 800
  570. 5660 PRINT "With Release 7,  the program will calculate and print the aspects"
  571. 5670 PRINT "between the planets.   The aspects,  angles,  and orbs which  the"
  572. 5680 PRINT "program uses are as follows:"
  573. 5690 PRINT ""
  574. 5700 PRINT "Aspects               Angles      Orbs"
  575. 5710 PRINT "-------               ------      ----"
  576. 5720 PRINT "CJN  Conjunction       0 degrees   7 degrees"
  577. 5730 PRINT "OPP  Opposition      180 degrees   7 degrees"
  578. 5740 PRINT "TRI  Trine           120 degrees   7 degrees"
  579. 5750 PRINT "SQR  Square           90 degrees   7 degrees"
  580. 5760 PRINT "SXT  Sextile          60 degrees   5 degrees"
  581. 5770 PRINT "SSQ  Semi-square      45 degrees   2 degrees"
  582. 5780 PRINT "SES  Sesquiquadrate  135 degrees   2 degrees"
  583. 5790 PRINT "INC  Inconjunct      150 degrees   2 degrees"
  584. 5800 PRINT "QTL  Quintile         72 degrees   2 degrees"
  585. 5810 PRINT ""
  586. 5820 PRINT "Following  the  aspect  routine,  the  program  then  permits  an" 
  587. 5830 PRINT "unlimited  number of additional charts to be calculated,  at  the" 
  588. 5840 PRINT "end  of  each of which the program will ask you if  you  want  to" 
  589. 5850 PRINT "compare that chart's positions to those of the first chart.  This" 
  590. 5860 PRINT "can be useful for two purposes:  planetary transits and synastry."
  591. 5870 PRINT ""
  592. 5880 GOSUB 800
  593. 5890 PRINT "To  determine the transiting aspects influencing an individual on"
  594. 5900 PRINT "a particular date, you would enter the person's birth information"
  595. 5910 PRINT "for   the  first  chart  and  then  enter  the  transiting   time"
  596. 5920 PRINT "information for the second chart."
  597. 5930 PRINT ""
  598. 5940 PRINT "This  same routine permits a comparison between the birth  charts"
  599. 5950 PRINT "of two people for relationship purposes.  This procedure is known"
  600. 5960 PRINT "as  synastry when it involves looking at the aspects between  two"
  601. 5970 PRINT "persons'  respective  planets.   Any  of the major  aspects  will"
  602. 5980 PRINT "establish communication at a deeper than superficial  level,  but"
  603. 5990 PRINT "the  primary  aspects for relationships are the  Conjunction  and"
  604. 6000 PRINT "Opposition.   Generally,  one  is  looking  for  aspects  between"
  605. 6010 PRINT "different  planets,  not  between the same planets,  in  the  two"
  606. 6020 PRINT "charts.  For friendship, understanding, and help, the significant"
  607. 6030 PRINT "points  are the sun,  moon,  ascendant,  and Jupiter.   For close"
  608. 6040 PRINT "friendship or romance, the significant points are Venus and Mars."
  609. 6050 PRINT ""
  610. 6060 PRINT "As  a practical application of synastry,  should any single women"
  611. 6070 PRINT "out there discover their own charts to be compatible with a chart"
  612. 6080 PRINT "for 01.111954; AM; 07.02; 8; 118; and 34, I would love to receive"
  613. 6090 PRINT "a letter from you."
  614. 6100 PRINT ""
  615. 6110 GOSUB 800
  616. 6120 PRINT "The  majority of this program was assembled and adapted from  the"
  617. 6130 PRINT "numerous   subprograms  contained  in  the  Manual  of   Computer"
  618. 6140 PRINT "Programming for Astrologers by Michael Erlewine with acknowledge-"
  619. 6150 PRINT "ment  to James Neely for the planetary routines.   This book  was"
  620. 6160 PRINT "published without copyright in 1980 by The American Federation of"
  621. 6170 PRINT "Astrologers, Inc.  The routines of this book are in Commodore PET"
  622. 6180 PRINT "and Apple II BASIC."
  623. 6190 PRINT ""
  624. 6200 PRINT "If  you have printed out the horoscope positions of yourself or a" 
  625. 6210 PRINT "friend  and then want to know "+CHR$(34)+"But what does it mean?"+CHR$(34)+",  I  think" 
  626. 6220 PRINT "the  best book for interpreting horoscopes and aspects is  Heaven"
  627. 6230 PRINT "Knows What by Grant Lewi;  its companion volume for transits  and"
  628. 6240 PRINT "planetary sign positions is called Astrology for the Millions."
  629. 6250 PRINT ""
  630. 6260 PRINT ""
  631. 6270 PRINT "                         John Halloran"
  632. 6280 PRINT "                         P.O. Box 75713"
  633. 6290 PRINT "                         Los Angeles, CA 90075"
  634. 6300 PRINT ""
  635. 6310 PRINT ""
  636. 6320 RETURN
  637. 6330 '------------------------------
  638. 6340 '   Data block
  639. 6350 '------------------------------
  640. 6360 DATA SUN,MOO,MER,VEN,MAR,JUP,SAT,URA,NEP,PLU,ASC,MID
  641. 6370 DATA CJN7000,OPP7180,TRI7120,SQR7090,SXT5060,SSQ2045,SES2135,INC2150,QTL2072
  642. 6380 ' Sun elements
  643. 6390 DATA 358.4758,35999.0,-.0002,.01675,-.4E-4,0,1,101.2208,1.7192,.00045,0,0
  644. 6400 DATA 0,0,0,0
  645. 6410 ' Mercury elements
  646. 6420 DATA 102.2794,149472.515,0,.205614,.2E-4,0,.3871,28.7538,.3703,.0001
  647. 6430 DATA 47.1459,1.1852,.0002,7.009,.00186,0
  648. 6440 ' Venus elements
  649. 6450 DATA 212.6032,58517.8039,.0013,.00682
  650. 6460 DATA -.5E-4,0,.7233,54.3842,.5082,-.14E-2,75.7796,.8999,.4E-3
  651. 6470 DATA 3.3936,.1E-2,0
  652. 6480 ' Mars elements
  653. 6490 DATA 319.5294,19139.8585,.2E-3,.09331,.9E-4,0,1.5237,285.4318
  654. 6500 DATA 1.0698,.1E-3,48.7864,.77099,0,1.8503,-.7E-3,0
  655. 6510 ' Jupiter elements
  656. 6520 DATA 225.4928,3033.6879,0
  657. 6530 DATA .04838,-.2E-4,0,5.2029,273.393,1.3383,0,99.4198,1.0583,0,1.3097
  658. 6540 DATA -.52E-2,0
  659. 6550 ' Jupiter harmonic terms
  660. 6560 DATA -.001,-.0005,.0045,.0051,581.7,-9.7,-.0005,2510.7,-12.5
  661. 6570 DATA -.0026,1313.7,-61.4,.0013,2370.79,-24.6,-.0013,3599.3,37.7,-.001,2574.7
  662. 6580 DATA 31.4,-.00096,6708.2,-114.5,-.0006,5499.4,-74.97,-.0013,1419,54.2,.0006
  663. 6590 DATA 6339.3,-109,.0007,4824.5,-50.9,.0020,-.0134,.0127,-.0023,676.2,.9,.00045
  664. 6600 DATA 2361.4,174.9,.0015,1427.5,-188.8,.0006,2110.1,153.6,.0014,3606.8,-57.7
  665. 6610 DATA -.0017,2540.2,121.7,-.00099,6704.8,-22.3,-.0006,5480.2,24.5,.00096
  666. 6620 DATA 1651.3,-118.3,.0006,6310.8,-4.8,.0007,4826.6,36.2
  667. 6630 ' Saturn elements
  668. 6640 DATA 174.2153,1223.50796
  669. 6650 DATA 0,.05423,-.2E-3,0,9.5525,338.9117,-.3167,0,112.8261,.8259,0,2.4908
  670. 6660 DATA -.0047,0
  671. 6670 ' Saturn harmonic terms
  672. 6680 DATA -.0009,.0037,0,.0134,1238.9,-16.4,-.00426,3040.9,-25.2,.0064
  673. 6690 DATA 1835.3,36.1,-.0153,610.8,-44.2,-.0015,2480.5,-69.4,-.0014,.0026,0,.0111
  674. 6700 DATA 1242.2,78.3,-.0045,3034.96,62.8,-.0066,1829.2,-51.5,-.0078,640.6,24.2
  675. 6710 DATA -.0016,2363.4,-141.4,.0006,-.0002,0,-.0005,1251.1,43.7,.0005,622.8
  676. 6720 DATA 13.7,.0003,1824.7,-71.1,.0001,2997.1,78.2
  677. 6730 ' Uranus elements
  678. 6740 DATA 74.1757,427.2742,0,.04682
  679. 6750 DATA .00042,0,19.2215,95.6863,2.0508,0,73.5222,.5242,0,.7726,.1E-3,0
  680. 6760 ' Uranus harmonic terms
  681. 6770 DATA -.0021
  682. 6780 DATA -.0159,0,.0299,422.3,-17.7,-.0049,3035.1,-31.3,-.0038,945.3,60.1
  683. 6790 DATA -.0023,1227,-4.99,.0134,-.02186,0,.0317,404.3,81.9,-.00495,3037.9,57.3
  684. 6800 DATA .004,993.5,-54.4,-.0018,1249.4,79.2,-.0003,.0005,0,.0005,352.5,-54.99
  685. 6810 DATA .0001,3027.5,54.2,-.0001,1150.3,-88
  686. 6820 ' Neptune elements
  687. 6830 DATA 30.13294,240.45516,0,.00913,-.00127
  688. 6840 DATA 0,30.11375,284.1683,-21.6329,0,130.68415,1.1005,0,1.7794,-.0098,0
  689. 6850 ' Neptune harmonic terms
  690. 6860 DATA .1832
  691. 6870 DATA -.6718,.2726,-.1923,175.7,31.8,.0122,542.1,189.6,.0027,1219.4,178.1
  692. 6880 DATA -.00496,3035.6,-31.3,-.1122,.166,-.0544,-.00496,3035.3,58.7,.0961,177.1
  693. 6890 DATA -68.8,-.0073,630.9,51,-.0025,1236.6,78,.00196,-.0119,.0111,.0001
  694. 6900 DATA 3049.3,44.2,-.0002,893.9,48.5,.00007,1416.5,-25.2
  695. 6910 ' Pluto elements
  696. 6920 DATA 229.781,145.1781,0
  697. 6930 DATA .24797,.002898,0,39.539,113.5366,.2086,0,108.944,1.3739,0,17.1514
  698. 6940 DATA -.0161,0
  699. 6950 ' Pluto harmonic terms
  700. 6960 DATA -.0426,.073,-.029,.0371,372,-331.3,-.0049,3049.6,-39.2,-.0108
  701. 6970 DATA 566.2,318.3,.0003,1746.5,-238.3,-.0603,.5002,-.6126,.049,273.97,89.97
  702. 6980 DATA -.0049,3030.6,61.3,.0027,1075.3,-28.1,-.0007,1402.3,20.3,.0145,-.0928
  703. 6990 DATA .1195,.0117,302.6,-77.3,.00198,528.1,48.6,-.0002,1000.4,-46.1
  704. 7000 ' ** EOF **
  705. .1,-.0007,1402.3,20.3,.0145,-.0928
  706. 699